home *** CD-ROM | disk | FTP | other *** search
- 'Note:
- ' You may have trouble running this program from the editor. If so,
- 'change the Path$ variable in INITIALISE to point to the directory this
- 'example is in. This isn't a problem when compiled.
-
- '*************************************************************************
- '*
- '* Font Tester
- '*
- '*************************************************************************
-
- ' Another simple little program - this lets the user select a font, then
- ' type stuff with it on a little demo window. Totally pointless, but fun.
- ' As usual, the startup code, window and menus were doen in GadToolsBox,
- ' with the last two procedures (for actually handling input) added by me.
- '
- ' This program really demonstrates simple menu handling.
-
- '** These are from GadToolsBox
- Global _SCRAPTAGS,SCRAPTAGS,_PORTLIST,_MESSLIST
- Global PATH$,OSVER
- Global FHEIGHT,FWIDTH,MBAR,OX,OY,SW,SH
- Dim _FONTGADS(0)
- Global _FONTGADS()
- Global _FONTMENU,_FONTMENADD
- Global _FONTWIND
-
- '** These are mine
- 'FX,FY - the present drawing position
- 'MYASL - the asl font requester FXEDWIDTH - only used fixed width fonts?
- Global FX,FY
- Global MYASL,FXEDWIDTH
-
- On Error Proc _CLEANUP
- _INITIALIZE
- _GUIDATA
- _SETUPALL
- _SETPORTS
-
- '** Set up the font requester with a few appropriate tags
-
- J Tag _SCRAPTAGS,1,Equ("ASLFO_TitleText"),J Make String("Select a font")
- J Tag Equ("ASLFO_SleepWindow"),True
- J Tag Equ("ASLFO_Window"),_FONTWIND
- J Tag 0,0
- MYASL=J Create Asl Requester(Equ("ASL_FontRequest"),_SCRAPTAGS)
-
- Do
- K=J Wait Message
- While K
- C=J Tag Data(_MESSLIST,1)
- If C=Equ("IDCMP_CLOSEWINDOW")
- _CLEANUP
- Else If C=Equ("IDCMP_REFRESHWINDOW")
- _DOREFRESH
- Else
- _HANDLEFONTWIND[C]
- End If
- K=J Next Message
- Wend
- Loop
-
- '** normal GadToolsBox generated code
-
- Procedure _INITIALIZE
- Procedure _SETUPALL
- Procedure _GUIDATA
- Procedure _MAKEFONTGADS
- Procedure _MAKEFONTWIND[SC]
- Procedure _DOREFRESH
- Procedure _SETPORTS
- Procedure _FREEWIND[W,G,M,A,C]
- Procedure _CLEANUP
-
- '** My procedures for handling everything
-
- Procedure _HANDLEFONTWIND[C]
- On Error Proc _CLEANUP
-
- '** First determine what the user has done.
- ' On clicking a the LMB on the window, we change the drawing position
- ' FX, FY
- ' If a key is pressed, write the key as text to the window
- ' If a menu item is selected, call the seperate menu handler
-
- If C=Equ("IDCMP_MOUSEBUTTONS")
- 'The two tags here contain mouse coordinates
- FX=J Tag Data(_MESSLIST,5)-J X Offset
- FY=J Tag Data(_MESSLIST,6)-J Y Offset
-
- Else If C=Equ("IDCMP_VANILLAKEY")
- 'write the character to the screen, then increment x position
- If J Tag Data(_MESSLIST,2)>31
- Text FX,FY+J Text Height,Chr$(J Tag Data(_MESSLIST,2))
- FX=FX+Text Length(Chr$(J Tag Data(_MESSLIST,2)))
- End If
-
- Else If C=Equ("IDCMP_MENUPICK")
- 'obtain the menu definition
- A=J Tag Data(_MESSLIST,2)
- M=J Read Menu(A)
- I=J Read Item(A)
- S=J Read Subitem(A)
- _HANDLEFONTMENU[M,I,S]
-
- End If
-
- End Proc
- Procedure _HANDLEFONTMENU[M,I,S]
- On Error Proc _CLEANUP
-
- 'project menu
- If M=0
-
- 'new font
- If I=0
- 'call the font requester, if the user selects a valid font
- 'change to it.
- J Tag _SCRAPTAGS,1,Equ("ASLFO_FixedWidthOnly"),FXEDWIDTH
- J Tag 0,0
- If J Font Request(MYASL,_SCRAPTAGS)
- J Set Font
- End If
-
- 'quit
- Else If I=2
- _CLEANUP
- End If
-
- 'font menu
- Else If M=1
-
- 'one of the writing style flags
- If I<3
- 'first, read state of all the writing style items
- J Tag _SCRAPTAGS,1,$80000011,J Menu Item(1,0,-1)
- J Tag $80000011,J Menu Item(1,1,-1)
- J Tag $80000011,J Menu Item(1,2,-1)
- J Tag 0,0
- J Get Menu Data _FONTMENU,_FONTWIND,_SCRAPTAGS
- 'This expression takes the three seperate results of J Get Menu Data
- 'and converts them into a single binary number suitable for Gr Writing
- 'Note the use of the Sgn command as J Get Menu Data will return random
- 'positive numbers, not always 1.
- Gr Writing Sgn(J Tag Data(_SCRAPTAGS,1))+2*Sgn(J Tag Data(_SCRAPTAGS,2))+4*Sgn(J Tag Data(_SCRAPTAGS,3))
-
- 'fixed width only
- Else If I=4
- 'flip state of the fixed width flag
- Add FXEDWIDTH,1,0 To 1
- End If
-
- 'style menu
- Else If M=2
-
- 'read all style flags
- J Tag _SCRAPTAGS,1,$80000011,J Menu Item(2,2,-1)
- J Tag $80000011,J Menu Item(2,3,-1)
- J Tag $80000011,J Menu Item(2,4,-1)
- J Tag 0,0
- J Get Menu Data _FONTMENU,_FONTWIND,_SCRAPTAGS
- 'this unpleasant looking expression takes the states of the bold,
- 'italic and underline menu items, and combines them into one number
- Set Text Sgn(J Tag Data(_SCRAPTAGS,3))+2*Sgn(J Tag Data(_SCRAPTAGS,1))+4*Sgn(J Tag Data(_SCRAPTAGS,2))
-
- 'display menu
- Else If M=3
- J Cls 0
- End If
-
- End Proc
-